Introduction to Shiny, Session 3
Bioinformatics Resource Center - Rockefeller University
http://rockefelleruniversity.github.io/RU_course_template/
brc@rockefeller.edu
Session 3 - Improving app experience - dynamic UIs and user feedback
Recap
Upload a file
We will pick up wih the app we built in Sessions 1 and 2 (below).
The app contains some nice reactive elements, but this app would be more useful if you could use any file on your computer with differential expression results as opposed to having to change the path in our app to look at a different set of results.
We will modify our app to upload a file.
Upload a file
We can use the fileInput function in the UI to allow the user to input a file. The ‘accept’ argument to limit the type of file the user can try to upload.
ui_upload <- page_fluid(
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), #<<
dataTableOutput(outputId = "all_data"),
)
server_upload <- function(input, output){
de_table_in <- reactive({
rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$all_data = renderDataTable({
datatable(de_table_in(),
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
}Upload a file
The help page for fileInput (?fileInput) explains that once a file is loaded, then the value returned to the server is a data frame, and one of the columns is the path to the temporary file path where Shiny is holding the file.
This path is used below in the de_table_in reactive expression to read in the dataframe.
ui_upload <- page_fluid(
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
dataTableOutput(outputId = "all_data"),
)
server_upload <- function(input, output){
de_table_in <- reactive({
rio::import(input$de_file$datapath) %>% #<<
dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$all_data = renderDataTable({
datatable(de_table_in(),
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
}
The req() function
In the previous UI, the user sees an error until a file is uploaded. This is because the file path is NULL and the rio::import function throws an error.
Shiny has a handy function req that can be added to a reactive context and the reactive or output function won’t run if the value passed to req is NULL. We modify the reactive in the server function that reads in the table.
server_uploadReq <- function(input, output){
de_table_in <- reactive({
req(input$de_file) #<<
rio::import(input$de_file$datapath) %>%
dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$all_data = renderDataTable({
datatable(de_table_in(),
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
}
Add upload to main app - UI
ui_fileInput <- page_navbar(
title = "RNAseq tools",
theme = custom_theme,
nav_panel(
title = "DE Analysis",
layout_sidebar(
sidebar = sidebar(
width = 300,
# >>>>>>>>>
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
# >>>>>>>>>
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
actionButton("de_filter", "Apply filter")
),
layout_columns(
navset_card_tab(
title = "DE result tables",
nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")),
nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))
),
card(card_header("MA plot"),
plotOutput("ma_plot"),
downloadButton("download_ma_plot", "Download MA plot", style = "width:40%;")),
card(card_header("Volcano plot"),
plotOutput("volcano_plot"),
downloadButton("download_volcano_plot", "Download volcano plot", style = "width:40%;")),
col_widths = c(12,6,6), row_heights = c("750px", "500px")
)
)
),
nav_panel(title = "Next steps","The next step in our analysis will be..."),
nav_spacer(),
nav_menu(title = "Links",
align = "right",
nav_item(tags$a(shiny::icon("chart-simple"), "RU BRC - Learn more!", href = "https://rockefelleruniversity.github.io/",target = "_blank"))
)
)Add upload to main app - server
The filtered table reactive and plot reactives use this table to apply the filtering cut offs, so we change these reactives to use this table and add de_table_in() to bindEvent so that they are updated when a new dataset is uploaded.
# part of server function, not run in isolation...
filtered_de <- reactive({
req(input$de_file)
de_table_in() %>% #<<
dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) #<<# part of server function, not run in isolation...
ma_plot_reac <- reactive({
de_table_in() %>% #
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, label = Symbol)) + geom_point() +
scale_x_log10() + scale_color_manual(name = "DE status", values = c("red", "grey")) +
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) #<<Add upload to main app - server
server_fileInput = function(input, output) {
# >>>>>>>>>>>>>>>>>>>>>>>>
de_table_in <- reactive({
req(input$de_file)
rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
})
# >>>>>>>>>>>>>>>>>>>>>>>>
output$download_ma_plot <- downloadHandler(
filename = function() {
"maplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = ma_plot_reac())
}
)
output$download_volcano_plot <- downloadHandler(
filename = function() {
"volcanoplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = volcano_plot_reac())
}
)
output$all_data = renderDataTable({
datatable(de_table_in(), # >>>>>>>>>>>>>>>>>>>>>>>>
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
filtered_de <- reactive({
de_table_in() %>% # >>>>>>>>>>>>>>>>>>>>>>>>
dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) # >>>>>>>>>>>>>>>>>>>>>>>>
output$de_data = renderDataTable({
datatable(filtered_de(),
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
ma_plot_reac <- reactive({
de_table_in() %>% # >>>>>>>>>>>>>>>>>>>>>>>>
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, label = Symbol)) + geom_point() +
scale_x_log10() + scale_color_manual(name = "DE status", values = c("red", "grey")) +
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) # >>>>>>>>>>>>>>>>>>>>>>>>
output$ma_plot = renderPlot({
ma_plot_reac()
})
volcano_plot_reac <- reactive({
de_table_in() %>% # >>>>>>>>>>>>>>>>>>>>>>>>
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig)) +
geom_point() +
scale_color_manual(name = "DE status", values = c("red","grey")) + theme_bw()
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) # >>>>>>>>>>>>>>>>>>>>>>>>
output$volcano_plot = renderPlot({
volcano_plot_reac()
})
}
Using uiOutput/renderUI functions
]
We still have empty boxes when the app starts even though we don’t have any data to fill that space. There are also buttons that don’t do anything because there is no data yet. This is likely to be confusing for a user.
A nice way to deal with this is the uiOutput function, which allows you to change the user interface after the app is running based on other inputs or code in the server.
So far our user interface is set up at the start and while the contents might change based on other reactives, we haven’t been able to make new inputs or outputs after the app has been started. ]
Using uiOutput/renderUI functions
]
We could improve the flow of our app by making the filter inputs in the sidebar only appear once a user has loaded in a differential table.
These filter inputs aren’t relevant until the data is loaded, so we will only make them appear once the de_table_in() value is a dataframe, suggesting a file has been loaded and a table successfully read in. ]
Using uiOutput/renderUI functions
The inputs for applying filters to our differential table are replaced with a uiOutput function call with an ID used in the output object in the server function This holds a location within the UI for us to eventually fill with server code.
ui_renderUI <- page_fluid(
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
uiOutput("sidebar_filters_UI"), #<<
)
server_renderUI <- function(input, output){
de_table_in <- reactive({
req(input$de_file)
rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$sidebar_filters_UI <- renderUI({
req(de_table_in())
div(numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
actionButton("de_filter", "Apply filter"))
})
}Using uiOutput/renderUI functions
These inputs are moved to the server within an output object paired with renderUI and are conditional on de_table_in() being a dataframe.
library(rio)
ui_renderUI <- page_fluid(
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
uiOutput("sidebar_filters_UI"),
)
server_renderUI <- function(input, output){
de_table_in <- reactive({
req(input$de_file)
rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$sidebar_filters_UI <- renderUI({ #<<
req(de_table_in()) #<<
div(numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),#<<
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),#<<
actionButton("de_filter", "Apply filter"))#<<
})#<<
}Using uiOutput/renderUI functions
EXPLAIN the DIV function!
Using uiOutput/renderUI functions
]
We will also hide the tables and plots since they are of no use until a file is uploaded. Empty elements can confuse the user and make it seem like something is wrong. ]
Using uiOutput/renderUI functions
Conditional UIs can also take advantage of more complex if statements to determine what is shown. In the example below, if not data frame is loaded, then we output a message for the user and once data is loaded, the table is shown.
ui_renderUI_table <- page_fluid(
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
uiOutput("all_data_UI") #<<
)
server_renderUI_table <- function(input, output){
de_table_in <- reactive({
req(input$de_file)
rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
output$all_data_UI <- renderUI({ #<<
if(is.null(input$de_file)) { #<<
div("You must load data!", style = "color: #273449; font-weight: bold;") #<<
}else if(!is.null(de_table_in())){ #<<
navset_card_tab(nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))) #<<
} #<<
}) #<<
output$all_data = renderDataTable(datatable(de_table_in()))
}
Handling invalid input files
A common problem when allowing an input file is the likelihood a user uploads a file that causes an error in the app. Here we are looking for a table with speific columns, so we should confirm that the file is valid.
There are a few ways to do this in Shiny, and we will introduce a new Shiny function to handle this, the validate function.
Use validate function to check input file
Validate prevents the alarming red error messages that are unhelpful to the user. This function can be used within a reactive expression, and the validation test is often called within a need function call.
Need takes an expression to evaluate, and if it is FALSE, then it will display a string provided in the ‘message’ argument in any output that depends on this reactive.
Use validate function to check input file
We use validate in the server function to check for the key columns in the table as we know that not having these columns will cause a downstream error in the app.
ui_validate_small <- page_fluid(
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
uiOutput("all_data_UI")
)
server_validate_small <- function(input, output){
de_table_in <- reactive({
req(input$de_file)
file_in <- rio::import(input$de_file$datapath)
validate(need(expr = all(c("baseMean", "log2FoldChange", "lfcSE", "stat", "pvalue", "padj") %in% colnames(file_in)), #<<
message = "You must have the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'")) #<<
file_in %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$all_data_UI <- renderUI({
if(is.null(input$de_file)) {
div("You must load data!", style = "color: #273449; font-weight: bold;")
}else if(!is.null(de_table_in())){
navset_card_tab(nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data")))
}
})
output$all_data = renderDataTable(datatable(de_table_in()))
}Use validate function to check input file
Update main app
Recap of changes: * use uiOutput/renderUI to make the filter inputs and button from the sidebar conditional on the table being uploaded * use uiOutput/renderUI to display a message if there is not datapath loaded and only show the DE table one a valid table is read into the app. * add validate + need to the reactive expression where we read in the table from the user to make sure a valid inut file was used
Update main app - UI
ui_renderUIall <- page_navbar(
title = "RNAseq tools",
theme = custom_theme,
nav_panel(
title = "DE Analysis",
layout_sidebar(
sidebar = sidebar(
width = 300,
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
uiOutput("sidebar_filters_UI") # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
),
uiOutput("table_plots_UI"), # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
)
),
nav_panel(title = "Next steps","The next step in our analysis will be..."),
nav_spacer(),
nav_menu(title = "Links",
align = "right",
nav_item(tags$a(shiny::icon("chart-simple"), "RU BRC - Learn more!", href = "https://rockefelleruniversity.github.io/",target = "_blank"))
)
)Update main app - server
server_renderUIall = function(input, output) {
de_table_in <- reactive({
req(input$de_file)
file_in <- rio::import(input$de_file$datapath)
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
validate(
need(expr = all(c("baseMean", "log2FoldChange", "lfcSE", "stat", "pvalue", "padj") %in% colnames(file_in)),
message = "You must have the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'")
)
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
file_in %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$all_data = renderDataTable({
datatable(de_table_in(), filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
output$table_plots_UI <- renderUI({
if(is.null(input$de_file)) {
layout_columns("No data has been loaded! Upload a DE table with the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'", style = "color: #273449; font-weight: bold;")
}else if(!is.null(de_table_in())){
layout_columns(
navset_card_tab(
title = "DE result tables",
nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")),
nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))
),
card(card_header("MA plot"),
plotlyOutput("ma_plot"),
downloadButton("download_ma_plot", "Download MA plot", style = "width:40%;")),
card(card_header("Volcano plot"),
plotlyOutput("volcano_plot"),
downloadButton("download_volcano_plot", "Download volcano plot", style = "width:40%;")),
col_widths = c(12,6,6), row_heights = c("750px", "500px")
)
}
})
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
output$sidebar_filters_UI <- renderUI({
req(de_table_in())
div(
"DE filters",
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
actionButton("de_filter", "Apply filter")
)
})
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
filtered_de <- reactive({
de_table_in() %>%
dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)
output$download_ma_plot <- downloadHandler(
filename = function() {
"maplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = ma_plot_reac())
}
)
output$download_volcano_plot <- downloadHandler(
filename = function() {
"volcanoplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = volcano_plot_reac())
}
)
output$de_data = renderDataTable({
datatable(filtered_de(),
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
ma_plot_reac <- reactive({
de_table_in() %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, label = Symbol)) + geom_point() +
scale_x_log10() + scale_color_manual(name = "DE status", values = c("red", "grey")) +
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)
output$ma_plot = renderPlotly({
ggplotly(ma_plot_reac())
})
volcano_plot_reac <- reactive({
de_table_in() %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig)) +
geom_point() +
scale_color_manual(name = "DE status", values = c("red","grey"),) + theme_bw()
ggtitle("Volcano plot")
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)
output$volcano_plot = renderPlotly({
ggplotly(volcano_plot_reac())
})
}Observers
Observers
Sometimes we might want our app to react to a change in an input, but we don’t need to return a value like reactive or we don’t need to change one of the outputs. Maybe we want to write to a database when a button is clicked, or notify the user that something has happened.
Often the observe function is used for this purpose, to perform a side effect when an input changes.
Like the reactive function or an output, observe creates a reactive context that takes dependencies on inputs. Though unlike a reactive expression, an observer does not return a value and is eager in its evaluation, meaning it will evaluate the code every time an input it depends on changes.
Observers - notification for user
We will add a nice message for the user to notify them that a new data set has been loaded.
To do this we use the Shiny function showNotification. This takes text that will be the message, a duration in seconds for the notification to remain open, and a ‘type’ argument, which will control the color. We set ‘duration’ to be NULL, which means the user will have to click to close the notification, guaranteeing they will see it.
This function is within an observe function call in the server and takes a dependency on the input table with bindEvent. Notice we don’t set the result to be a variable because an observer returns nothing, it just runs the code it contains.
Observers - notification for user
ui_notify <- page_fluid(
fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
uiOutput("all_data_UI"))
server_notify <- function(input, output){
de_table_in <- reactive({
req(input$de_file)
file_in <- rio::import(input$de_file$datapath)
})
observe({ #<<
showNotification("A new table has been loaded into the app!", duration = NULL, type = "message") #<<
}) %>% #<<
bindEvent(de_table_in()) #<<
output$all_data_UI <- renderUI({
if(is.null(input$de_file)) {
div("Load data!", style = "color: #273449; font-weight: bold;")
}else{ navset_card_tab(nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))) }
})
output$all_data = renderDataTable(datatable(de_table_in()))
}
Update app with notification - server
server_notify = function(input, output) {
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
observe({
showNotification("A new table has been loaded into the app!", duration = NULL, type = "message")
}) %>%
bindEvent(de_table_in())
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
de_table_in <- reactive({
req(input$de_file)
file_in <- rio::import(input$de_file$datapath)
validate(
need(expr = all(c("baseMean", "log2FoldChange", "lfcSE", "stat", "pvalue", "padj") %in% colnames(file_in)),
message = "You must have the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'")
)
file_in %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
})
output$all_data = renderDataTable({
datatable(de_table_in(), filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
output$table_plots_UI <- renderUI({
if(is.null(input$de_file)) {
layout_columns("No data has been loaded! Upload a DE table with the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'", style = "color: #273449; font-weight: bold;")
}else if(!is.null(de_table_in())){
layout_columns(
navset_card_tab(
title = "DE result tables",
nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")),
nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))
),
card(card_header("MA plot"),
plotlyOutput("ma_plot"),
downloadButton("download_ma_plot", "Download MA plot", style = "width:40%;")),
card(card_header("Volcano plot"),
plotlyOutput("volcano_plot"),
downloadButton("download_volcano_plot", "Download volcano plot", style = "width:40%;")),
col_widths = c(12,6,6), row_heights = c("750px", "500px")
)
}
})
output$sidebar_filters_UI <- renderUI({
req(de_table_in())
div(
"DE filters",
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
actionButton("de_filter", "Apply filter")
)
})
filtered_de <- reactive({
de_table_in() %>%
dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)
output$download_ma_plot <- downloadHandler(
filename = function() {
"maplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = ma_plot_reac())
}
)
output$download_volcano_plot <- downloadHandler(
filename = function() {
"volcanoplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = volcano_plot_reac())
}
)
output$de_data = renderDataTable({
datatable(filtered_de(),
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
ma_plot_reac <- reactive({
de_table_in() %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, label = Symbol)) + geom_point() +
scale_x_log10() + scale_color_manual(name = "DE status", values = c("red", "grey")) +
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)
output$ma_plot = renderPlotly({
ggplotly(ma_plot_reac())
})
volcano_plot_reac <- reactive({
de_table_in() %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig)) +geom_point() +
scale_color_manual(name = "DE status", values = c("red","grey"),) +theme_bw()
}) %>%
bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)
output$volcano_plot = renderPlotly({
ggplotly(volcano_plot_reac())
})
}Notification for user - app
use observer to let user enter file name for plots?
also can use observer when you introduce the update* series of functions
Publishing apps on shinyapps.io
While it may be useful to simply have a Shiny app on your computer that you can run and analyze data locally, you might also want to publish the app in order to share with others, or allow you to access it anywhere.
Posit (aka RStudio) provides the opportunity to deploy apps for free on shinyapps.io, which is nicely integrated into RStudio. The free version allows for a limited number of apps and not much memory, but is a good place to get started. We will go through a simple deployment.
We first need to install and load the rsconnect package.
Publishing apps on shinyapps.io
It is then necessary to make an account on shinyapps.io, and then use the rsconnect package to connect RStudio to the shinyapps.io account.
First the token from shinyapps.io needs to be retrieved:
Publishing apps on shinyapps.io
After running the command copied from shinyapps.io that includes the token and secret, we can then publish our app.
If you have a valid app file open, right next to the ‘Run App’ button, there is another button that allows you to publish the app. The shinyapps.io account that you just linked should be there for deployment.
Publishing apps on shinyapps.io
The rsconnect package will then bundle the app and any packages the app uses. After some time, the log in the ‘Deploy’ tab in the RStudio console (bottom of IDE) will indicate sucessful deployment and the app should appear on shinyapps.io with a valid and public URL.
other ideas for later on
- reactiveValues()
- intorduce ways to include custom HTML
- custom CSS?
- debugging?
- mention shiny in python?
Further Resources
Contact
Any suggestions, comments, edits or questions (about content or the slides themselves) please reach out to our GitHub and raise an issue.
– ## Exercises The following few slides show you how to structure exercise slides.
We often have several exercise slides per session. So you can just copy and paste and change the directory to the appropriate name. All 3 file types are made from you single exercise Rmd.
Time for an exercise!
Exercises for Session 3 are here